perm filename BUILTC.NEW[1,JRA]1 blob sn#025632 filedate 1973-02-21 generic text, type T, neo UTF8

(DEFPROP BUILTCH1 
 (LAMBDA(X)
  (COND ((ATOM X)
	 (COND ((EQ X (QUOTE ANCESTRY)) (SETQ ANCESTRY T) NIL)
	       ((EQ X (QUOTE NONE)) NIL)
	       ((MEMQ X (QUOTE (VINE ALLPOS ALLNEG UNIT)))
		(LIST (QUOTE OR) (LIST X (QUOTE C1)) (LIST X (QUOTE C2))))
	       (T X)))
	((EQ (CAR X) (QUOTE SUPPORT)) (SETSUP (CDR X)) (QUOTE (SUPPORT C2)))
	((EQ (CAR X) (QUOTE MODEL)) (SETQ PMODEL (CADR X))
				    (SETQ NMODEL (CADDR X))
				    (QUOTE (OR (NOT (MODEL C1)) (NOT (MODEL C2)))))
	((EQ (CAR X) (QUOTE DEFMODEL))
	 (LIST (QUOTE OR)
	       (LIST (QUOTE NOT) (LIST (CDR X) (QUOTE C1)))
	       (LIST (QUOTE NOT) (LIST (CDR X) (QUOTE C2)))))
	((EQ (CAR X) (QUOTE ANCESTRY)) (SETQ ANCESTRY T) (BUILTCH1 (CDR X)))
	((ATOM (CAR X)) (CONS (BUILTCH1 (CAR X)) (BUILTCH1 (CDR X))))
	((EQ (CAAR X) (QUOTE EQUALITY)) (SETQ PFLG NIL)
					(SETQ EQUAL (CADAR X))
					(SETQ PDEPTH (CADDAR X))
					(BUILTCH1 (CDR X)))
	(T (CONS (BUILTCH1 (CAR X)) (BUILTCH1 (CDR X)))))) 
EXPR)